perm filename MEMIO[GEM,BGB] blob
sn#092034 filedate 1974-03-21 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00025 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 TITLE MEMIO - MEMORY AND INPUT/OUTPUT ROUTINES - BGB - FEBRUARY 1974.
C00006 00003
C00009 00004 SUBR(MKCAMERA,WORLD)
C00011 00005 SUBR(MKWINDOW,CAMERA,WINDOW) MAKE AND LINK A WINDOW NODE.
C00013 00006 FAIL MORE CORE.
C00015 00007 SAIL MORE CORE.
C00018 00008 SUBR(MKNODE,NODTYP) ALLOCATE A BLOCK OF NODSIZ WORDS.
C00020 00009 TITLE IO - GEM INPUT/OUTPUT - BGB - FEBRUARY 1973.
C00023 00010 SUBR(PLOTO) DISPLAY BUFFER TO DISK FILE.
C00024 00011 SUBR(TVHELP,FILLOC) HELP - DISPLAY DOCUMENTATION.
C00027 00012 SUBN(GETFIL,EXT) SETUP FILE SPEC FROM TTY LINE.
C00030 00013 SUBR(GETCHW) GET CHARACTER WAIT.
C00033 00014 SUBN(SERIAL,BODY) SERIAL NUMBER THE FEV OF A BODY FOR OUTPUT.
C00036 00015 SUBN(OFEV,BODY) OUTPUT THE FEV OF A BODY.
C00038 00016 SUBN(OBODY,BODY) OUTPUT BODY AND ITS PARTS.
C00039 00017 SUBR(OUTB3D,BODY) OUTPUT B3D BODY.
C00041 00018 SUBR(INCAM) INPUT CAMERA.
C00043 00019 SUBR(OUTCAM) OUTPUT CAMERA.
C00045 00020 SUBN(IFEV,BODY) INPUT F.E.V. BLOCKS.
C00048 00021 SUBN(IBODY,BODY0) INPUT A BODY AND ALL ITS PARTS.
C00050 00022 SUBR(INB3D) INPUT B3D FORMAT.
C00052 00023 SUBR(INGEO) INPUT GEO COMMANDS.
C00054 00024 SUBR(OUTV2D) OUTPUT VECTOR 2-D FILE FOR MAKE VIDEO.
C00056 00025
C00058 ENDMK
C⊗;
TITLE MEMIO - MEMORY AND INPUT/OUTPUT ROUTINES - BGB - FEBRUARY 1974.
;LANGUAGE COMPATIBLITY ROUTINES.
;--------------------------------------------------------------------
;SAIL ACCUMULATORS PROTECTED: 12,16,17.
IFN SAIL{
ENTRY.↑: 0 ;SAIL TO GEM.
DAC 12,SAIL12
DAC 16,SAIL16
GO@ENTRY.
EXIT.↑: 0 ;GEM TO SAIL.
LAC 12,SAIL12
LAC 16,SAIL16
GO@EXIT.
SAIL12↑:0
SAIL16↑:0
ENTERS↑:-1
LIT}
;--------------------------------------------------------------------
;LISP ACCUMULATORS PROTECTED: 0,14,15,16,17.
IFN LISP{
DEFINE NUMVAL(AC){
TRNE AC,400000↔GO .+4
CDR AC,(AC)↔CDR AC,(AC)↔SKIPA AC,(AC)
SUBI AC,577777}
ENTRY.↑:0 ;LISP TO GEM.
DAC 0,LISP0↔LAC[XWD 5,LISP0+5]
BLT 0,LISP0+17↔LAC 17,14 ;USE LISP PDL.
CDR ENTRY.↔SUBI 3↔CAR@↔ANDI 7 ;NUMBER OF ARGUMENTS.
JUMPE @ENTRY.
NUMVAL(1)↔PUSH P,1↔SOSG↔PUSHJ P,@ENTRY.
NUMVAL(2)↔PUSH P,2↔SOSG↔PUSHJ P,@ENTRY.
NUMVAL(3)↔PUSH P,3↔SOSG↔PUSHJ P,@ENTRY.
NUMVAL(4)↔PUSH P,4↔SOSG↔PUSHJ P,@ENTRY.
SKIPA
EXIT.↑: 0 ;GEM TO LISP.
LAC 0,[XWD LISP0+5,5]↔BLT 0,17
LAC 0,LISP0
TLNE 1,-1↔GO MAKNUM↑ ;FLONUM.
GO MAKNUM+1 ;FIXNUM.
ENTERS↑: -1↔LISP0:BLOCK 20}
;--------------------------------------------------------------------
OLD44↑: 0 ;ORIGINAL JOBREL 44 CONTENTS.
UNIVER↑:0 ;POINTER TO UNIVERSE NODE.
BLKCNT↑:0 ;NUMBER OF NON EMPTY NODES.
AVAIL↑: 0 ;POINTER TO FIRST EMPTY NODE.
NODSIZ←←=12 ;NUMBER OF WORDS PER NODE.
MINLINK←←-3 ;LOWEST NUMBERED LINK.
REMAINDER:0 ;NUMBER OF UNUSED WORDS BETWEEN
; THE TOP OF NODE SPACE AND THE TOP OF CORE.
SUBR(MKUNIV) ;MAKE UNIVERSE.
COMMENT .-----------------------------------------------------------.
CALL(MORCOR) ;MAKE UNIVERSE NODE.
SETQ(WORLD,{MKWORLD}) ;MAKE A WORLD FOR THIS UNIVERSE.
SETQ(CAMERA,{MKCAMERA,WORLD}) ;MAKE A CAMERA FOR THIS WORLD.
CALL(MKWINDOW,CAMERA,[0]) ;MAKE A WINDOW FOR THIS CAMERA.
POP0J
DECLARE{WORLD,CAMERA}
ENDR MKUNIV;7/12/73(BGB)---------------------------------------------
SUBR(MKWORLD) ;MAKE A WORLD NODE.
COMMENT .-----------------------------------------------------------.
SETQ(WORLD#,{MKNODE,[$WORLD]})
CW. 1,1↔CCW. 1,1 ;EMPTY BODY RING.
BRO. 1,1↔SIS. 1,1 ;WORLD RING.
CALL(MKFRAME↑) ;WORLD FRAME OF REFERENCE.
LAC 2,WORLD
FRAME. 1,2
;PLACE NEW WORLD AT THE END OF THE WORLD RING.
LAC 1,WORLD
LAC 4,UNIVERSE↔PWRLD 2,4 ;GET FIRST WORLD OF THIS UNIVERSE.
JUMPN 2,[BRO 3,2
BRO. 1,2↔SIS. 2,1 ;RING-IN THE NEW WORLD.
SIS. 1,3↔BRO. 3,1↔GO .+3]
NWRLD. 1,4↔PWRLD. 1,4 ;INIT THE UNIVERSE'S WORLD RING.
;MAKE A SUN FOR THIS WORLD.
SETQ(SUN#,{MKCAMERA,[0]}) ;MAKE A SUN (LIKE A CAMERA).
MOVEI $SUN↔DAP(1) ;MARK THE NODE AS SUN TYPE.
FRAME 2,1↔LAC[100.0]↔DAC ZWC(2) ;PLACE SUN A HUNDRED FEET UP.
LAC 2,WORLD↔ALT. 1,2↔PWRLD. 2,1 ;PLACE THE SUN IN THE WORLD.
;RETURN WORLD.
LAC 1,WORLD↔POP0J
ENDR MKWORLD;3/12/73(BGB)--------------------------------------------
SUBR(MKCAMERA,WORLD)
COMMENT .------------------------------------------------------------
If WORLD argument is not zero then place camera in world's camera ring.
SETQ(CAMERA#,{MKNODE,[$CAMERA]})
BRO. 1,1↔SIS. 1,1 ;CAMERA RING.
SKIPE 2,WORLD↔PWRLD. 2,1 ;CAMERA POINTS AT ITS WORLD.
;DEFAULT PHYSICAL RASTER SIZE.
DEFINE MM{3.280833E-3}
DEFINE MICRON{3.280833E-6}
LAC[38.78]↔FMPR[MICRON]↔DAC 1(1) ;PDX.
LAC[40.00]↔FMPR[MICRON]↔DAC 2(1) ;PDY.
LAC[12.50]↔FMPR[MM]↔ DAC 3(1) ;FOCAL
LAC[XWD =288,=216]↔DAC 8(1) ;COLUMNS,,ROWS. ;LDX,,LDY
MOVN 3(1)↔FDVR 1(1)↔DAC -3(1) ;SCALEX ← -FOCAL/PDX
MOVN 3(1)↔FDVR 2(1)↔DAC -2(1) ;SCALEY ← -FOCAL/PDY
MOVN 3(1)↔FDVR 2(1)↔DAC -1(1) ;SCALEZ ← -FOCAL/PDZ
;CAMERA LOCUS AND ORIENTATION.
CALL(MKFRAME↑)
LAC[16.0]↔DAC ZWC(1) ;16 FEET ABOVE XY PLANE.
LAC 2,CAMERA↔FRAME. 1,2
;PLACE NEW CAMERA AT THE END OF THE WORLD'S CAMERA RING.
LAC 1,CAMERA
LAC 4,WORLD↔PCAMR 2,4 ;GET FIRST CAMERA OF THIS WORLD.
JUMPN 2,.+4
NCAMR. 1,4↔PCAMR. 1,4 ;INIT THE WORLD'S CAMERA RING.
POP1J
BRO 3,2
BRO. 1,2↔SIS. 2,1 ;RING-IN THE NEW CAMERA.
SIS. 1,3↔BRO. 3,1↔POP1J
ENDR MKCAMERA;3/12/73(BGB)-------------------------------------------
SUBR(MKWINDOW,CAMERA,WINDOW) ;MAKE AND LINK A WINDOW NODE.
COMMENT .------------------------------------------------------------
CAMERA argument may be zero;
Zero WINDOW argument will cause a new Display ring;
Otherwise new window placed into the display ring of the given window.
CALL(MKNODE,[$WINDOW]) ;WINDOW CREATION.
LAC[3.5]↔DAC -1(1) ;MAGNIFICATION.
LAC[XWD -=511,=511]↔DAC 1(1) ;XWD XL,,XH
LAC[XWD -=384,=384]↔DAC 2(1) ;XWD YL,,YH
LAC CAMERA↔NCAMR. 0,1 ;POINTER TO CAMERA.
BRO. 1,1↔SIS. 1,1 ;WINDOW RING.
CW. 1,1↔CCW. 1,1 ;DISPLAY RING.
;PLACE NEW WINDOW IN DISPLAY RING NEXT TO GIVEN WINDOW.
SKIPN 2,WINDOW↔GO L1
PVT 0,2↔AOS↔PVT. 0,1 ;INCREMENT SERIAL NUMBER.
SIS 3,2
SIS. 1,2↔BRO. 2,1
BRO. 1,3↔SIS. 3,1↔POP2J
;PLACE NEW WINDOW IN BRAND NEW DISPLAY RING, ALL BY ITSELF.
L1: AOS 3(1) ;SERIAL NUMBER #1.
LAC 4,UNIVERSE↔CCW 2,4 ;GET FIRST DISPLAY RING.
CW. 1,4↔CCW. 1,4 ;UPDATE UNIVERSE NODE.
JUMPE 2,POP2J. ;EXIT WHEN FIRST DISPLAY RING.
CW 3,2
CW. 1,2↔CCW. 2,1 ;RING-IN A NEW DISPLAY RING.
CCW. 1,3↔CW. 3,1
POP2J
ENDR MKWINDOW;3/12/73(BGB)-------------------------------------------
;FAIL MORE CORE.
IFE SAIL{
SUBR(MORCOR)
COMMENT .-----------------------------------------------------------.
;INITIALIZE THE UNIVERSE NODE WHEN NECESSARY.
SKIPE UNIVERSE↔GO L1 ;SKIP ON FIRST TIME ONLY.
SKIPE 1,OLD44↔CORE 1,↔JFCL ;CORE DOWN.
LAC 1,JOBREL↑↔DAC 1,OLD44 ;SAVE JOBREL.
SETZM REMAINDER
ADDI 1,4↔DAC 1,UNIVERSE
L1: LAC 1,UNIVERSE
MOVEI -1(1)↔DAC BLKCNT# ;POINTER TO NODES COUNTER.
MOVEI 1(1)↔DAC AVAIL# ;POINTER TO AVAIL LIST.
;FOUR MORE K.
LAC 1,JOBREL↔LAC JOBREL↔ADDI 10000
CORE↔FATAL<NO MORE CORE>
AOS 1↔SUB 1,REMAINDER
DAC 2,AC2#↔LAC 2,JOBREL
SETZM(1)↔HRLI(1)↔HRRI(1)1↔BLT(2)
MOVEI 2↔DAP @UNIVERSE ;UNIVERSE NODE IS TYPE #2.
;MAKE AVAIL LIST.
DIP 1,1↔ADD 1,[XWD NODSIZ+3,3] ;XWD NEXT,,THIS.
SKIPN@BLKCNT↔GO[
ADD 1,[XWD NODSIZ,NODSIZ] ;STEP OVER THE UNIVERSE NODE.
AOS@BLKCNT↔GO .+1] ;COUNT THE UNIVERSE NODE.
HRRZM 1,@AVAIL
L2: HLRZM 1,1(1)↔AOS(1) ;EMPTY LINK & EMPTY NODE TYPE #1.
ADD 1,[XWD NODSIZ,NODSIZ] ;ADVANCE ONE NODE.
CAILE 2,NODSIZ+NODSIZ-1-3(1) ;TEST FOR LAST NODE BUT ONE.
GO L2↔AOS(1)
;COMPUTE CORE REMAINDER.
SUBI 2,NODSIZ-1-3(1)↔DAC 2,REMAINDER
MOVEI 10000↔LAC 1,UNIVER↔ADDM -3(1) ;CORE SIZE.
LAC 1,@AVAIL↔LAC 2,AC2↔POP0J
ENDR MORCOR;4-DEC-72(BGB)
}
;SAIL MORE CORE.
IFN SAIL{
SUBR(MORCOR)------------------------------------------------------
ACCUMULATORS{PTR,SIZ}
;GET MORE CORE FROM SAIL - BGB - 8 MARCH 1972.
PUSH P,PTR↔PUSH P,SIZ↔SETZ PTR,
L1: MOVEI SIZ,NODSIZ*=400+1 ;AC3 SIZE OF SPACE.
CALL(CORGET↑) ;AC2 ADDRESS OF SPACE.
GO[FATAL(NO MORE CORE.)]↔SOS SIZ
MOVSI(PTR)↔HRRI 1(PTR)↔SETZM(PTR) ;CLEAR 4K BLOCK OF MEMORY.
BLT NODSIZ*=400-1(PTR) ;CLEAR 4K BLOCK OF MEMORY.
LAC 1,PTR ;-3 WORD OF FIRST NODE.
;INITIALIZE THE UNIVERSE WHEN NECESSARY.
SKIPE 2,UNIVER↔GO L3↔LAC 2,1
ADDI 2,3↔DAC 2,UNIVERSE ;POINTER TO UNIVERSE NODE.
MOVEI 2↔DAP @UNIVERSE ;UNIVERSE NODE IS TYPE #2.
L3: MOVEI -1(2)↔DAC BLKCNT# ;POINTER TO NODES COUNTER.
MOVEI 1(2)↔DAC AVAIL# ;POINTER TO AVAIL LIST.
;MAKE AVAIL LIST.
DIP 1,1↔ADD 1,[XWD NODSIZ+3,3] ;XWD NEXT,,THIS
SKIPN @BLKCNT↔GO[
ADD 1,[XWD NODSIZ,NODSIZ] ;STEP OVER UNIVERSE.
AOS @BLKCNT↔SUBI SIZ,NODSIZ↔GO .+1] ;COUNT UNIVERSE NODE.
SUBI SIZ,NODSIZ ;ALL BUT THE LAST.
HRRZM 1,@AVAIL ;FIRST AVAIL NODE.
;PLACE EACH NEW EMPTY BLOCK ON THE AVAIL LIST.
L2: HLRZM 1,1(1)↔AOS(1) ;EMPTY LIST POINTER & TYPE #1.
ADD 1,[XWD NODSIZ,NODSIZ]
SUBI SIZ,NODSIZ
JUMPG SIZ,L2↔AOS(1) ;LAST AVAIL NODE.
LAC 1,@AVAIL ;FIRST AVAIL NODE.
POP P,3↔POP P,2↔POP0J
ENDR MORCOR;------------------------------------------------------
}
SUBR(MKNODE,NODTYP) ;ALLOCATE A BLOCK OF NODSIZ WORDS.
COMMENT .-----------------------------------------------------------.
LAC 1,UNIVERSE↔AOS -1(1) ;COUNT OF NODES IN USE.
MOVEI 1,1(1)↔DAC 1,TMP1# ;POINTER TO AVAIL LIST.
SKIPN 1,0(1)↔CALL(MORCOR) ;EMPTY AVAIL LIST.
CDR 1(1)↔DAP @TMP1 ;NEXT AVAILABLE NODE.
SETZM 1(1) ;CLEAR THIS NODE.
LAC NODTYP↔DAC(1)↔POP1J ;PLACE NODE TYPE BITS.
ENDR MKNODE;2/22/74(BGB)---------------------------------------------
SUBR(KLNODE,NODE) ;RELEASE BLOCK OF NODSIZ WORDS.
COMMENT .-----------------------------------------------------------.
SKIPN 1,NODE↔POP1J ;WOULDN'T KILL NIL.
LAC(1)↔CAIN 0,1 ;TEST FOR EMPTY NODE.
GO[FATAL(KILLING EMPTY NODE.)] ;CAN'T KILL AN EMPTY.
HRLI -3(1)↔HRRI -2(1) ;CLEAR NODE.
SETZM -3(1)↔BLT 8(1)↔AOS(1) ;MARK NODE TYPE EMPTY-1.
LAC UNIVERSE↔SOS↔SOS@↔ADDI 2 ;COUNT OF NODES IN USE.
HRL 1,@↔HLRZM 1,1(1)↔HRRZM 1,@ ;CONS NODE INTO AVAIL LIST.
POP1J
ENDR KLNODE;2/22/74(BGB)---------------------------------------------
;TITLE IO - GEM INPUT/OUTPUT - BGB - FEBRUARY 1973.
EXTERN MKB,MKF,MKE,MKV,MKFRAME,BATT,FCCW
INTERN MACPTR,MACCNT,MACNOD,FILFLG
↓CMDCHN←←16
↓IODEND←20000
FILNAM:0 ;FILE NAME.
EXTION:0↔0 ;EXTENSION.
PPPN:0 ;PROJECT-PROGRAMMER.
STRING: 0 ;SAIL STRING BYTE POINTER.
STRCNT: -1 ;SAIL STRING CHAR COUNT.
OBUF:BLOCK 3 ;OUTPUT BUFFER HEADER.
IBUF:BLOCK 3 ;INPUT BUFFER HEADER.
IOBUF: BLOCK 2*(201+2)
CMDHDR: BLOCK 3 ;COMMAND BUFFER HEADER
CMDBUF: BLOCK 2*(201+2)
MACPTR: 0
MACCNT: 0
MACNOD: 0 ;IF NON-ZERO, ADDRESS OF TEXT NODE
FILFLG: 0 ;COMMAND FILE
EOF: 0 ;END OF FILE FLAG.
GEMFLG: 0 ;KIND OF FILE FORMAT: 0 FOR B3D, -1 FOR GEM.
GEMASK: 400417000077 ;IGNORED STATUS BITS ON GEM INPUT.
BLOCK 3
BFRAME:BLOCK 9 ;BODY FRAME BUFFER.
PCNT:0 ;PARTS COUNT.
FCNT:0 ;FACE COUNT.
ECNT:0 ;EDGE COUNT.
VCNT:0 ;VERTEX COUNT.
PLTFLG↑: 0 ;SET DURING PLOT OUTPUT TO DISABLE III KLUDGES
SUBN(WORDO,WORD) ;WORD OUTPUT.
COMMENT .-----------------------------------------------------------.
LAC WORD
SOSG OBUF+2↔OUT 1,0
GO[IDPB 0,OBUF+1↔POP1J]
FATAL(WORDO)
ENDR;2/18/73(BGB)----------------------------------------------------
WORDIN: ;----------------------------------------------------------
BEGIN WORDIN; WORD INPUT TO AC0 - BGB - 18 FEBRUARY 1973.
SOSG IBUF+2↔IN 1,0
GO[ILDB 0,IBUF+1↔POPJ P,]
STATO 1,1B22↔GO[FATAL(WORDIN)]
SETOM EOF↔POPJ P,
BEND;2/18/73(BGB)--------------------------------------------------
SUBR(PLOTO) ;DISPLAY BUFFER TO DISK FILE.
COMMENT .-----------------------------------------------------------.
; SETOM PLTFLG
; CALL(GEODPY↑)
; SETZM PLTFLG
CALL(GETFIL,[SIXBIT/PLT/])↔POP0J
LAC 1,DPYBUF↑↔MOVN(1)1↔SUBI 2
CDR 2,(1)↔SETZM 1(2)
MOVS↔HRRI -1(1)↔DAC DUMLST
INIT 1,17↔SIXBIT/DSK/↔0↔HALT
ENTER 1,FILNAM↔GO .+4
OUT 1,DUMLST↔JFCL
RELEASE 1,
POP0J
DUMLST: 0↔0
ENDR PLOTO;12/10/72(BGB)---------------------------------------------
SUBR(TVHELP,FILLOC) ;HELP - DISPLAY DOCUMENTATION.
COMMENT .-----------------------------------------------------------.
EXTERNAL REALI,JOBREL,JOBFF
EXTERNAL DPYSET,DPYOUT,DPYBIG,DPYBRT,AIVECT,RIVECT,DTYO,DPYBUF
SETZM INHDR
INIT 17,↔SIXBIT/DSK/↔INHDR
GO [FATAL(CAN'T INIT DSK)]
MOVEI 1,2↔HRL 1,FILLOC↔BLT 1,5
LOOKUP 17,2↔GO[OUTSTR[ASCIZ/HELP FILE NOT FOUND.
/]↔ POP1J ]
PUSH P,JOBFF↔PUSH P,JOBREL↔LAC 1,JOBREL↔DAC 1,JOBFF
USETI 17,1↔SETSTS 17,0↔MOVEI 0,4↔GO PGLOOP-1 ;START 'EM ON PAGE-4.
LOOP: USETI 17,1↔SETSTS 17,0↔OUTSTR[ASCIZ/PAGE = /]
CALL(REALI)↔FIXX↔JUMPE 0,RET↔DAC 0,PAGNUM#
SOJLE 0,FOUND
PGLOOP: CALL(GETCHR)↔GO[OUTSTR[ASCIZ/PAGE NOT FOUND.
/]↔ GO RET]
CAIE 1,14↔GO PGLOOP↔GO PGLOOP-1
FOUND: CALL(DPYSET,DPYBUF)↔CALL(AIVECT,[0],[=440])
CALL(DPYBIG,[1])↔CALL(DPYBRT,[1])↔SETZM LPOS#
CHLOOP: CALL(GETCHR)↔GO FIN
CAIN 1,14↔GO FIN
CAIN 1,11↔GO[CALL(DTYO,[40])
AOS 1,LPOS↔TRNE 1,7↔GO $.-4↔GO CHLOOP]
CALL(DTYO,1)↔AOS LPOS↔LAC 1,1(P)
CAIE 1,15↔GO CHLOOP
SETZM LPOS↔CALL(RIVECT,[1000],[0])
GO CHLOOP
FIN: CALL(DPYOUT,[16])↔GO LOOP
RET: RELEASE 17,↔POP P,JOBFF↔LAC 1,JOBFF
CORE 1,↔GO[FATAL(CAN'T SHRINK CORE)]
POP P,JOBFF↔POP1J
GETCHR: SOSG INHDR+2↔IN 17,
GO[ILDB 1,INHDR+1↔AOS(P)↔POP0J ] ;SKIP ON CHARACTER.
POP0J
INHDR: BLOCK 3
ENDR TVHELP;---------------------------------------------------------
SUBN(GETFIL,EXT) ;SETUP FILE SPEC FROM TTY LINE.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{PTR,CNT}
SETZM FILNAM↔SETZM EXTION ;CLEAR FILNAME BLOCK.
SETZM EXTION+1↔SETZM PPPN
IFN SAIL{LAC 16,SAIL16↑↔POP 16,STRING ;SAIL STRING ARGUMENT.
POP 16,0↔HRRZM STRCNT↔DAC 16,SAIL16↑↔SKIPLE STRCNT↔GO L0}
;TYPE OUT DEFAULT EXTENSION AND "FILE = ".
OUTCHR[9]↔LAC 1,EXT↔JUMPE 1,.+6
SETZ↔ROTC 6↔ADDI 40↔OUTCHR↔GO .-5
OUTSTR[ASCIZ/ FILE = /]
;FIRST CHARACTER.
L0: LAC PTR,[POINT 6,FILNAM,-1]
MOVEI CNT,6 ;BYTE PTR AND CHR COUNT.
CALL(GETCHL)↔DAC 1,0
CAIL "a"↔SUBI 40
CAIN 15↔GO[CALL(GETCHL)↔POP1J]↔AOSA(P) ;SKIP FILE NAME GIVEN.
;SCAN FOR FILENAME DELIMITERS.
L: CALL(GETCHL)↔DAC 1,0↔CAIL "a"↔SUBI 40
CAIN "."↔GO[SETZM EXT↔LAC PTR,[POINT 6,EXTION,-1]↔MOVEI CNT,3↔GO L]
CAIN "["↔GO[LAC PTR,[POINT 6,PPPN,-1]↔MOVEI CNT,3↔GO L]
CAIN ","↔GO[LAC PTR,[POINT 6,PPPN,17]↔MOVEI CNT,3↔GO L]
CAIN "]"↔GO L
CAIN 15↔GO EOL↔CAIN 12↔GO EOL ;END OF THE LINE.
JUMPE EOL+1 ;NULL CHARACTER - AT END OF SAIL STRINGS.
CAIG " "↔GO L ;IGNORE GARBAGE.
SOJL CNT,L
SUBI 40↔IDPB PTR↔GO L ;ASCII TO SIXBIT.
;RIGHT ADJUST SHORT PPPN'S.
EOL: CALL(GETCHL)↔CAR PPPN
TRNN 77↔LSH -6↔TRNN 77↔LSH -6 ;RIGHT ADJUST PROJECT.
DIP PPPN↔CDR PPPN
TRNN 77↔LSH -6↔TRNN 77↔LSH -6 ;RIGHT ADJUST PROGRAMMER.
DAP PPPN
SKIPN 1,EXTION↔LAC 1,EXT ;DEFAULT EXTENSION.
DAC 1,EXTION↔POP1J
ENDR GETFIL;2/18/73(BGB)---------------------------------------------
SUBR(GETCHW) ;GET CHARACTER WAIT.
COMMENT .-----------------------------------------------------------.
IFN SAIL{SKIPL STRCNT↔GO[SOSGE STRCNT↔TDCA 1,1↔ILDB 1,STRING↔POP0J]}
SKIPE FILFLG↔CALL(FILCHR)↔INCHRW 1↔POP0J
ENDR GETCHW;2/23/74(BGB)---------------------------------------------
SUBR(GETCHL)
COMMENT .-----------------------------------------------------------.
IFN SAIL{SKIPL STRCNT↔GO[SOSGE STRCNT↔TDCA 1,1↔ILDB 1,STRING↔POP0J]}
SKIPE FILFLG↔CALL(FILCHR)↔INCHWL 1↔POP0J
ENDR GETCHL;2/23/74(BGB)---------------------------------------------
SUBN(FILCHR) ;GET FILE CHARACTER & SKIP.
COMMENT .-----------------------------------------------------------.
SOSG CMDHDR+2↔IN CMDCHN,
GO[ILDB 1,CMDHDR+1↔JUMPE 1,FILCHR↔AOS(P)↔POP0J ]
STATO CMDCHN,IODEND↔FATAL(READ ERROR IN COMMAND FILE)
RELEASE CMDCHN,
SETZB 1,FILFLG↔POP0J
ENDR FILCHR;2/23/74(BGB)---------------------------------------------
SUBN(SERIAL,BODY) ;SERIAL NUMBER THE FEV OF A BODY FOR OUTPUT.
COMMENT .-----------------------------------------------------------.
LAC 1,BODY↔TEST 1,BBIT↔POP1J
;COUNT FACES, EDGES, AND VERTICES.
MOVEI 1↔PFACE 1,1↔ALT. 0,1↔CAME 1,BODY↔AOJA .-3↔SOS↔DAC FCNT
MOVEI 1↔PED 1,1↔ALT. 0,1↔CAME 1,BODY↔AOJA .-3↔SOS↔DAC ECNT
MOVEI 1↔PVT 1,1↔ALT. 0,1↔CAME 1,BODY↔AOJA .-3↔SOS↔DAC VCNT
;COUNT PARTS.
SETZ↔SON 1,1↔DAC 1,2↔JUMPE 1,.+5↔AOS
BRO 2,2↔CAME 1,2↔AOJA .-2
DAC PCNT
;OUTPUT BODY HEADER.
CALL(WORDO,PCNT)
CALL(WORDO,FCNT)
CALL(WORDO,ECNT)
CALL(WORDO,VCNT)
LAC 1,BODY
CALL(WORDO,{-2(1)}) ;PNAME.
CALL(WORDO,{-1(1)}) ;PNAME.
SKIPN GEMFLG↔GO L0
CALL(WORDO,{0(1)}) ;BODY TYPE BITS.
CALL(WORDO,{8(1)}) ;USER'S BODY WORD.
;BODIES LOCATION ORIENTATION MATRIX.
L0: FRAME 1,1↔SKIPN 1↔MOVEI 1,L2 ;BODY'S FRAME OR EMPTY.
MOVEI 2,=12↔SUBI 1,3
L1: CALL(WORDO,{(1)})↔AOS 1↔SOJG 2,L1
POP1J
;EMPTY FRAME.
0↔0↔0
L2: 1.0↔0↔0↔ 0↔1.0↔0↔ 0↔0↔1.0
ENDR SERIAL;2/18/73(BGB)---------------------------------------------
SUBN(OFEV,BODY) ;OUTPUT THE FEV OF A BODY.
COMMENT .-----------------------------------------------------------.
LAC 1,BODY
;FACES.
L1: PFACE 1,1↔CAMN 1,BODY↔GO L2
CALL(WORDO,{4(1)}) ;FIRST FACE DATA WORD - REFLECTIVITIES.
CALL(WORDO,{5(1)}) ;SECOND FACE DATA WORD - ILLUMINOUSITIES.
SKIPN GEMFLG↔GO L1
CALL(WORDO,{0(1)}) ;BODY TYPE BITS.
CALL(WORDO,{8(1)}) ;USER'S BODY WORD.
GO L1
;EDGES.
L2: PED 1,1↔CAMN 1,BODY↔GO L3 ;OUTPUT EDGE NODES.
NFACE 2,1↔ALT 2,2↔DIP 2,0
PFACE 2,1↔ALT 2,2↔DAP 2,0↔LAC 2,(1)
TLNE 2,(DARKEN)↔TLO 1B18
TLNE 2,(NSHARP)↔TRO 1B18↔CALL(WORDO,0)
NVT 2,1↔ALT 2,2↔DIP 2,0
PVT 2,1↔ALT 2,2↔DAP 2,0↔CALL(WORDO,0)
NCW 2,1↔ALT 2,2↔DIP 2,0
PCW 2,1↔ALT 2,2↔DAP 2,0↔CALL(WORDO,0)
NCCW 2,1↔ALT 2,2↔DIP 2,0
PCCW 2,1↔ALT 2,2↔DAP 2,0↔CALL(WORDO,0)
SKIPN GEMFLG↔GO L2
CALL(WORDO,{0(1)}) ;BODY TYPE BITS.
CALL(WORDO,{8(1)}) ;USER'S BODY WORD.
GO L2
;VERTICES.
L3: PVT 1,1↔CAMN 1,BODY↔POP1J ;OUTPUT VERTEX NODES.
CALL(WORDO,{XWC(1)})
CALL(WORDO,{YWC(1)})
CALL(WORDO,{ZWC(1)})
SKIPN GEMFLG↔GO L3
CALL(WORDO,{0(1)}) ;BODY TYPE BITS.
CALL(WORDO,{8(1)}) ;USER'S BODY WORD.
GO L3
ENDR OFEV;2/18/73(BGB)-----------------------------------------------
SUBN(OBODY,BODY) ;OUTPUT BODY AND ITS PARTS.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{N,B}
CALL(SERIAL,BODY) ;SERIAL NUMBER THE F.E.V.
CALL(OFEV,BODY) ;OUTPUT THE F.E.V.
LAC B,BODY
SON N,B↔JUMPE N,L2 ;EXIT - AIN'T GOT NO PARTS.
L1: PUSHP N↔CALL(OBODY,N) ;RECURSE - ON SUB PARTS.
POPP N↔LAC B,BODY
BRO N,N↔SON 0,B
CAME 0,N↔GO L1
L2: POP1J
ENDR OBODY;2/18/73(BGB)----------------------------------------------
SUBR(OUTB3D,BODY) ;OUTPUT B3D BODY.
COMMENT .-----------------------------------------------------------.
LAC 1,BODY↔TEST 1,BBIT↔POP1J ;BODIES ONLY.
MOVSI'GEM'↔SKIPN GEMFLG↔MOVSI'B3D' ;DEFAULT EXTENSION.
L1: CALL(GETFIL,0)↔POP1J ;GET FILE NAME.
INIT 1,10↔SIXBIT/DSK/↔XWD OBUF,0↔HALT
ENTER 1,FILNAM↔GO[RELEASE 1,
OUTSTR[ASCIZ/ ENTER FAILED./]↔POP1J]
;SETUP OUTPUT BUFFERS.
MOVEI IOBUF↔EXCH JOBFF↑
OUTBUF 1,↔DAC JOBFF
;OUTPUT TRANSFER.
CALL(OBODY,BODY)
;END OF FILE.
RELEASE 1,
POP1J
ENDR OUTB3D;2/18/73(BGB)--------------------------------------------
SUBR(OUTGEM,BODY) ;OUTPUT B3D BODY.
COMMENT .-----------------------------------------------------------.
SETOM GEMFLG
CALL(OUTB3D,BODY)
SETZM GEMFLG
POP1J
ENDR OUTGEM;2/23/74(BGB)
SUBR(INCAM) ;INPUT CAMERA.
COMMENT .-----------------------------------------------------------.
C←←10↔R←←11 ;CAMERA & FRAME.
TDZA 1,1
L1: RELEASE 1,↔CALL(GETFIL,[SIXBIT/CAM/])↔GO[SETZ 1,↔POP0J]
INIT 1,10↔SIXBIT/DSK/↔IBUF↔HALT
LOOKUP 1,FILNAM↔GO L1
MOVEI IOBUF↔EXCH JOBFF
INBUF 1,↔DAC JOBFF
;FETCH NOW CAMERA.
LAC C,UNIVERSE↑↔NWRLD C,C
NCAMR C,C↔FRAME R,C↔CALL(KLNODE↑,R)
;INPUT TRANSFER.
CALL(WORDIN)↔FMPR FEET↔PUSH P,0 ;CX
CALL(WORDIN)↔FMPR FEET↔PUSH P,0 ;CY
CALL(WORDIN)↔FMPR FEET↔PUSH P,0 ;CZ
CALL(WORDIN)↔PUSH P,0 ;PAN
CALL(WORDIN)↔PUSH P,0 ;TILT
CALL(WORDIN)↔PUSH P,0 ;SWING
CALL(MKROT1↑)↔FRAME. 1,C
POP P,ZWC(1)↔POP P,YWC(1)↔POP P,XWC(1)
CALL(WORDIN)↔FMPR FEET↔DAC 1(C) ;PDX
CALL(WORDIN)↔FMPR FEET↔DAC 2(C) ;PDY
CALL(WORDIN)↔FMPR FEET↔DAC 3(C) ;PDZ
CALL(WORDIN)↔FMPR FEET↔DAC 1 ;FOCAL
MOVN 1↔FDVR 1(C)↔DAC -3(C) ;SCALEX
MOVN 1↔FDVR 2(C)↔DAC -2(C) ;SCALEY
MOVN 1↔FDVR 3(C)↔DAC -1(C) ;SCALEZ
DAC 1,3(C) ;FOCAL
RELEASE 1,↔POP0J
FEET:3.280833 ;FEET PER METER.
ENDR INCAM;2/21/73(BGB)----------------------------------------------
SUBR(OUTCAM) ;OUTPUT CAMERA.
COMMENT .-----------------------------------------------------------.
C←←10↔R←←11 ;CAMERA & FRAME.
L1: CALL(GETFIL,[SIXBIT/CAM/])↔POP0J
INIT 1,10↔SIXBIT/DSK/↔XWD OBUF,0↔HALT
ENTER 1,FILNAM↔GO[RELEASE 1,
OUTSTR[ASCIZ/ ENTER FAILED./]↔CRLF↔POP0J]
MOVEI IOBUF↔EXCH JOBFF↑↔OUTBUF 1,↔DAC JOBFF
;FETCH NOW CAMERA.
LAC 1,UNIVERSE↑↔NWRLD 1,1
NCAMR C,1↔FRAME R,C
;OUTPUT TRANSFER.
LAC -3(R)↔FMPR METERS↔CALL(WORDO,0) ;CX
LAC -2(R)↔FMPR METERS↔CALL(WORDO,0) ;CY
LAC -1(R)↔FMPR METERS↔CALL(WORDO,0) ;CZ
SETQ(TILT,{ACOS↑,{KZ(R)}})↔MOVN KY(R) ;TILT ← ACOS(KZ).
SETQ(PAN,{ATAN2↑,{KX(R)},0}) ;PAN ← ATAN2(KX,-KY).
CALL(SIN↑,TILT)↔LAC JZ(R)
JUMPE 1,.+4↔FDVR 0,1
SETQ(SWING,{ACOS↑,0}) ;SWING ← ACOS(JZ/SIN(TILT))
CALL(WORDO,PAN)
CALL(WORDO,TILT)
CALL(WORDO,SWING)
LAC 1(C)↔FMPR METERS↔CALL(WORDO,0) ;PDX
LAC 2(C)↔FMPR METERS↔CALL(WORDO,0) ;PDY
LAC 2(C)↔FMPR METERS↔CALL(WORDO,0) ;PDZ
LAC 3(C)↔FMPR METERS↔CALL(WORDO,0) ;FOCAL
RELEASE 1,↔POP0J
DECLARE{PAN,TILT,SWING}
METERS: 0.3048006 ;METERS PER FOOT.
ENDR OUTCAM;2/18/73---------------------------------------------------
SUBN(IFEV,BODY) ;INPUT F.E.V. BLOCKS.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F,E,V,A,I,J,FACE,EDGE,VERTEX}
;SETUP BASE POINTER TO SERIAL TABLES.
MOVSI I↔HRR DPYBUF↑
DAC FACE↔DAC EDGE↔DAC VERTEX
ADD VERTEX,FCNT
;MAKE AND INPUT FACES.
MOVEI I,1
L1: CALL(MKF,BODY)↔DAC 1,@FACE
CALL(WORDIN)↔DAC 4(1) ;FACE REFLECTIVITY.
CALL(WORDIN)↔DAC 5(1) ;FACE LUMENOSITY.
SKIPN GEMFLG↔GO L1A
CALL(WORDIN)↔AND GEMASK↔IORM (1);FACE TYPE BITS.
CALL(WORDIN)↔DAC 8(1) ;FACE USER WORD.
L1A: CAME I,FCNT↔AOJA I,L1
;MAKE AND INPUT EDGES.
MOVEI I,1
L2: CALL(MKE,BODY)↔DIP 1,@EDGE
CALL(WORDIN)
LAC 2,(1)
TLZE 1B18↔TLO 2,(DARKEN)
TRZE 1B18↔TLO 2,(NSHARP)
DAC 2,(1)↔DAC 0,1(1) ;TWO FACES.
CALL(WORDIN)↔DAC 3(1) ;TWO VERTICES.
CALL(WORDIN)↔DAC 4(1) ;EDGE'S WINGS.
CALL(WORDIN)↔DAC 5(1)
SKIPN GEMFLG↔GO L2A
CALL(WORDIN)↔AND GEMASK↔IORM (1);EDGE TYPE BITS.
CALL(WORDIN)↔DAC 8(1) ;EDGE USER WORD.
L2A: CAME I,ECNT↔AOJA I,L2
;MAKE AND INPUT VERTICES.
MOVEI I,1
L3: CALL(MKV,BODY)↔DAP 1,@VERTEX
CALL(WORDIN)↔DAC XWC(1) ;VERTEX WORLD LOCUS.
CALL(WORDIN)↔DAC YWC(1)
CALL(WORDIN)↔DAC ZWC(1)
SKIPN GEMFLG↔GO L3A
CALL(WORDIN)↔AND GEMASK↔IOR 0(1);TYPE BITS.
CALL(WORDIN)↔DAC 8(1) ;FACE USER WORD.
L3A: CAME I,VCNT↔AOJA I,L3
;CONVERT SERIAL NUMBERS TO NODE ADDRESSES.
MOVEI J,1
L4: LAC I,J↔CAR E,@EDGE
NFACE I,E↔CDR F,@FACE↔NFACE. F,E↔PED. E,F
PFACE I,E↔CDR F,@FACE↔PFACE. F,E↔PED. E,F
NVT I,E↔CDR V,@VERTEX↔NVT. V,E↔PED. E,V
PVT I,E↔CDR V,@VERTEX↔PVT. V,E↔PED. E,V
NCW I,E↔CAR A,@EDGE↔NCW. A,E
PCW I,E↔CAR A,@EDGE↔PCW. A,E
NCCW I,E↔CAR A,@EDGE↔NCCW. A,E
PCCW I,E↔CAR A,@EDGE↔PCCW. A,E
CAME J,ECNT↔AOJA J,L4
POP1J
ENDR IFEV;2/18/73(BGB)-----------------------------------------------
SUBN(IBODY,BODY0) ;INPUT A BODY AND ALL ITS PARTS.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{N,B,B0}
;INPUT BODY HEADER.
CALL(WORDIN)↔DAC PCNT
CALL(WORDIN)↔DAC FCNT
CALL(WORDIN)↔DAC ECNT
CALL(WORDIN)↔DAC VCNT
;INPUT THE FEV SHELL OF THIS BODY.
SETQ(B1,{MKB,BODY0})↔LAC B0,BODY0
JUMPN B0,[CALL(BATT,B1,B0)↔GO .+1]
LAC B,B1
CALL(WORDIN)↔DAC -2(B) ;PNAME.
CALL(WORDIN)↔DAC -1(B) ;PNAME.
SKIPN GEMFLG↔GO L1A
CALL(WORDIN)↔AND GEMASK↔IORM 0(B) ;BODY TYPE BITS.
CALL(WORDIN)↔DAC 8(B) ;BODY USER WORD.
L1A:
;INPUT THE LOCATION ORIENTATION OF THIS BODY.
MOVEI 1,BFRAME-3↔MOVEI 2,=12↔SETZ 4,
L1: CALL(WORDIN)↔DAC(1)↔IORM 4↔AOS 1↔SOJG 2,L1
CALL(MKFRAME)↔FRAME. 1,B↔JUMPE 4,.+4
MOVSI BFRAME-3↔HRRI XWC(1)↔BLT KZ(1)
SKIPN FCNT↔GO .+3↔CALL(IFEV,B)
LAC B,B1↔SKIPN BODY0↔DAC B,BODY0 ;RETURN VALUE TO TOP LEVEL.
;INPUT THE PARTS OF THIS BODY.
L2: SOSGE PCNT↔POP0J
PUSH P,PCNT↔PUSH P,B
CALL(IBODY)
POP P,B↔POP P,PCNT↔GO L2
B1:0
ENDR IBODY;2/18/73(BGB)----------------------------------------------
SUBR(INB3D) ;INPUT B3D FORMAT.
COMMENT .-----------------------------------------------------------.
TDZA 1,1
L1: RELEASE 1,
MOVSI'GEM'↔SKIPN GEMFLG↔MOVSI'B3D' ;GEM OR B3D.
CALL(GETFIL,0)↔GO[SETZ 1,↔POP0J]
INIT 1,10↔SIXBIT/DSK/↔IBUF↔HALT
LOOKUP 1,FILNAM↔GO[
SKIPG GEMFLG↔GO L1
OUTSTR[ASCIZ/FILE NOT FOUND./]
RELEASE 1,↔SETZ 1,↔POP0J] ;SAILOR'S LOSE HERE.
;SETUP INPUT BUFFERS.
MOVEI IOBUF↔EXCH JOBFF
INBUF 1,↔DAC JOBFF
;INPUT TRANSFER.
CALL(IBODY,[0])↔POP P,1
RELEASE 1,↔POP0J
ENDR INB3D;2/18/73(BGB)----------------------------------------------
SUBR(INGEM) ;INPUT GEM BODY.
COMMENT .-----------------------------------------------------------.
SETOM GEMFLG
CALL(INB3D)
SETZM GEMFLG
POP0J
ENDR INGEM;2/23/74(BGB)
SUBR(INGEO) ;INPUT GEO COMMANDS.
COMMENT .-----------------------------------------------------------.
TDZA 1,1
L1: RELEASE CMDCHN,
CALL(GETFIL,[SIXBIT/GEO/])↔GO[SETZ 1,↔POP0J]
INIT CMDCHN,0↔SIXBIT/DSK/↔CMDHDR↔HALT
LOOKUP CMDCHN,FILNAM↔GO L1
;SETUP INPUT BUFFERS.
MOVEI CMDBUF↔EXCH JOBFF
INBUF CMDCHN,↔DAC JOBFF
OUTSTR[ASCIZ/<OPENING COMMAND FILE>
/]↔ SETOM FILFLG
POP0J
ENDR INGEO;2/18/73(BGB)---------------------------------------------
SUBR(INCRE) ;INPUT CRE NODES.
COMMENT .-----------------------------------------------------------.
L1: CALL(GETFIL,[SIXBIT/CRE/])↔POP0J
INIT 1,17↔SIXBIT/DSK/↔0↔HALT
LOOKUP 1,FILNAM↔GO L1 ;FILE LOOKUP.
LAC PPPN↔HRRI 1B18-1↔DAC INARG ;DUMP COMMAND WORD.
MOVS PPPN↔MOVMS↔ADDI 1B18 ;FILE SIZE.
IORI 1777↔CORE2↔HALT ;MAKE UPPER SEGMENT.
IN 1,INARG↔RELEASE 1, ;INPUT TRANSFER.
CALL(CREIMG↑) ;MAKE PERCEIVED IMAGES.
SETZ↔CORE2↔HALT↔POP0J ;KILL UPPER SEGMENT.
INARG:0↔0
ENDR INCRE;3/14/73(BGB)----------------------------------------------
SUBR(OUTV2D) ;OUTPUT VECTOR 2-D FILE FOR MAKE VIDEO.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,E,F1,F2,V1,QQ7,V2}
;FILE OPENING CEREMONIES.
L1: CALL(GETFIL,[SIXBIT/V2D/])↔POP0J
INIT 1,10↔SIXBIT/DSK/↔XWD OBUF,0↔HALT
ENTER 1,FILNAM↔GO[RELEASE 1,
OUTSTR[ASCIZ/ ENTER FAILED./]↔CRLF↔POP0J]
MOVEI IOBUF↔EXCH JOBFF↑↔OUTBUF 1,↔DAC JOBFF
;CALL OCCULT.
CALL(TAKE2↑,[0])
SETZ QQ7, ;BACKGROUND INTENSITY !
LAC 1,UNIVERSE
SON 1,1↔DAC 1,WRLD#
LAC B,1
;FOR ALL THE BODIES OF THE WORLD.
L2: CCW B,B↔CAMN B,WRLD↔GO[
CALL(KLTMPS↑,WRLD)
RELEASE 1,↔POP0J]
;FOR ALL THE EDGES OF EACH BODY.
LAC E,B
L3: PED E,E↔CAMN E,B↔GO L2
TEST E,VISIBLE↔GO L3 ;VISIBLE.
PVT V1,E↔NVT V2,E
PFACE F1,E↔NFACE F2,E
;OUTPUT FIRST PART OF A V2D EDGE BLOCK.
CALL(WORDO,{1(E)}) ;NFACE,,PFACE.
CALL(WORDO,{XPP(V1)})
CALL(WORDO,{YPP(V1)})
CALL(WORDO,{XPP(V2)})
CALL(WORDO,{YPP(V2)})
;EDGE NOT SHARP - SMOOTH THE FACE INTENSITIES.
TEST E,NSHARP↔GO L4
CALL(MIDQQ,{QQ(F1)},{QQ(F2)})
DAC 1,QQMID1
DAC 1,QQMID2
TESTZ E,FOLDED↔GO[CW F2,E ;UNDERFACE OF A FOLD.
LAC QQ(F2)↔DAC QQMID2↔GO .+1]
CALL(WORDO,QQMID2)
CALL(WORDO,QQMID1)
CALL(WORDO,QQMID2)
CALL(WORDO,QQMID1)
GO L3
L4: TESTZ E,FOLDED↔CW F2,E ;UNDERFACE OF A FOLD.
CALL(WORDO,{QQ(F2)}) ;LEFT OF V1.
CALL(WORDO,{QQ(F1)}) ;RIGHT OF V1.
CALL(WORDO,{QQ(F2)}) ;LEFT OF V2.
CALL(WORDO,{QQ(F1)}) ;RIGHT OF V2.
GO L3
DECLARE{QQMID1,QQMID2}
ENDR OUTV2D;3/14/74(BGB)---------------------------------------------
SUBN(MIDQQ,Q1,Q2) ;AVERAGE TWO INTENSITY WORDS.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{X,P1,P2,A1,A2}
SAVAC(6)
LAC A1,Q1↔LAC A2,Q2
LAC P1,[POINT 9,A1]
LAC P2,[POINT 9,A2]
ILDB P1↔ILDB X,P2↔ADD X↔LSH -1↔ROTC -9
ILDB P1↔ILDB X,P2↔ADD X↔LSH -1↔ROTC -9
ILDB P1↔ILDB X,P2↔ADD X↔LSH -1↔ROTC -9
ILDB P1↔ILDB X,P2↔ADD X↔LSH -1↔ROTC -9
GETAC(6)
POP2J
ENDR MIDQQ;3/21/74(BGB)----------------------------------------------
END
MEMIO.FAI - EOF.